Loadstar 51/051.d81/tempered fun

Commodore BASIC | 2022-08-26 | 10KB | 325 lines

5 gosub60100:clr:restore
6 rem arrays for temperaments
10 dim eh(46),ph(46),jh(46),mh(46)
20 dim el(46),pl(46),jl(46),ml(46)
25 rem array for scales
30 dim hm(20),lm(20)
32 rem array for real time
35 dim as(8)
36 gosub 6000:restore:rem read ascii values for real time
40 poke53272,23:poke53280,7
45 rem menu 1
50 print"[147]":printtab(6);"[208][204][197][193][211][197] [215][193][201][212] . . . [211][197][212][212][201][206][199] [213][208]"
60 print"":printtab(12);"([193]bout 14 secs.)
70 [141]5000:[143] set up arrays
80 [151]648,4:[151]53281,0:[153]"cont";
82 [153]"load":[153][163]14);"(NULL)val(NULL)(NULL)val(NULL)valstr$ asc(NULL)(NULL)
85 printtab(14);"[163][163][163][163][163][163][163][163][163][163][163][163]"
90 printtab(17);"[205][197][206][213] 1":print
100 print"[201]. [212]emperaments
110 [153][163]3);"1.wait valqual"
120 [153][163]3);"2.wait (NULL)ythagorean"
130 [153][163]3);"3.wait mid$ust"
140 [153][163]3);"4.wait (NULL)ean"
150 [153][163]3);"5.wait (NULL)our own equal temperament"
155 [153]
160 [153]"right$right$. (NULL)cales"
170 [153][163]3);"1.wait (NULL)ajor"
180 [153][163]3);"2.wait (NULL)inor"
190 [153][163]3);"3.wait str$orian"
200 [153][163]3);"4.wait (NULL)hrygian"
210 [153][163]3);"5.wait (NULL)ydian"
220 [153][163]3);"6.wait (NULL)ixolydian"
230 [153][163]3);"7.wait atneolian"
240 [153][163]3);"8.wait (NULL)ocrian"
250 [153][163]3);"9.wait lenhromatic (b or #)
260 print"[150][197]nter number or [209] to quit. [154]";
270 poke198,0:poke204,0:poke207,0:wait198,1:poke204,1:getk$
271 ifk$="q"ork$="[209]"then60000
272 tu=val(k$):iftu=0then260
273 iftu=1ortu=2ortu=3ortu=4thenprintk$;:de=.5:gosub7000:goto280
274 iftu=5thenprintk$;:de=.5:gosub7000:goto1300
275 goto260
280 print"                                           ";
281 print"[150][197]nter number of desired scale. [154]";
282 poke198,0:poke204,0:poke207,0:wait198,1:poke204,1:getk$
283 mo=val(k$):ifmo=0then281
284 ifmo=1ormo=2ormo=3ormo=4ormo=5ormo=6ormo=7ormo=8thenprintk$;:de=.5:gosub7000:goto300
285 ifmo=9thenprintk$;:de=.5:gosub7000:goto287
286 rem chromatic scale
287 print"[147][212]his function will allow you to hear a  chromatic octave scale only
288 [153]"str$o you wish a chromatic scale on sharps or flats? (s/f) ";
289 [151]198,0:[151]204,0:[151]207,0:[146]198,1:[151]204,1:[161]k$:[139]k$[179][177]"s"[175]k$[179][177]"f"[167]289
290 [139]k$[178]"s"[167][153]k$:de[178].5:[141]7000:mo[178]9:ap[178]1:[137]400
291 [139]k$[178]"f"[167][153]k$:de[178].5:[141]7000:mo[178]10:ap[178]1:[137]400
299 [143] menu 1
300 [153]"load":[153][163]14);"(NULL)val(NULL)(NULL)val(NULL)valstr$ asc(NULL)(NULL)
305 printtab(14);"[163][163][163][163][163][163][163][163][163][163][163][163]"
310 printtab(17);"[205][197][206][213] 2":print
320 print"[201][201][201]. [193]pplications"
330 printtab(3);"1.[146] [207]ctave scale"
340 printtab(3);"2.[146] [210]oot chord"
350 printtab(3);"3.[146] [210]eal-time melody"
360 printtab(3);"4.[146] [212]winkle [204]ittle [211]tar (melody)
370 [153][163]3);"5.wait (NULL)winkle (NULL)ittle (NULL)tar (harmonized)"
380 [153]"defvalnter number of desired application. cont";
381 [151]198,0:[151]204,0:[151]207,0:[146]198,1:[151]204,1:[161]k$
382 ap[178][197](k$):[139]ap[178]0[167]380
383 [139]ap[178]1[176]ap[178]2[176]ap[178]3[176]ap[178]4[176]ap[178]5[167][153]k$;:de[178].5:[141]7000:[137]400
384 [137]380
399 [143] primary pivot point
400 [145]mo[141]5330,5350,5370,5390,5410,5430,5450,5470,5490,5510
405 [145]ap[137]500,600,700,900,1100
499 [143] octave scale
500 [153]"loadleft$val(NULL)valcloseright$(NULL)close(NULL)(NULL)(NULL)(NULL)close(NULL)len(NULL)atn(NULL)valclose(NULL)lenatn(NULL)val !":[153]"((NULL)ress <(NULL)(NULL)atnlenval peekatn(NULL)> to end early.)"
501 [141]2000
502 [143] play octave
504 [139]no[178]13[167]510
506 [129]i[178]8[164]15:[137]512
510 [129]i[178]8[164]20
512 [151]si,lm(i):[151]si[170]1,hm(i):[143] pitches
514 [151]si[170]4,17:[143] waveform gate #1 on
516 de[178]1:[141]7000:[143] duration
518 [151]si[170]4,16:[143] gate #1 off
519 [161]k$:[139]k$[178]" "[167]570
520 [130]
570 [141]8000:[153]:[153]:[153]"str$o you wish to hear it again? (y/n) ";
580 [141]3900
582 [139]k$[178]"n"[167][153]k$:de[178].5:[141]7000:[137]80
584 [153]k$:de[178].5:[141]7000:[137]500
599 [143] root chords
600 [153]"load":[153]"left$val(NULL)valcloseright$(NULL)close(NULL)(NULL)(NULL)(NULL)close(NULL)(NULL)(NULL)(NULL)closelenleft$(NULL)(NULL)str$close!"
602 [141]2000
610 [151]si,lm(8):[151]si[170]1,hm(8)
612 [151]si[170]7,lm(10):[151]si[170]8,hm(10)
614 [151]si[170]14,lm(12):[151]si[170]15,hm(12)
616 [151]si[170]4,17:[151]si[170]11,17:[151]si[170]18,17
620 [153]:[153]"(NULL)ress <(NULL)(NULL)atnlenval peekatn(NULL)> to continue.";
622 [161]k$:[139]k$[179][177]" "[167]622
660 [141]8000
670 [153]:[153]:[153]:[153]"str$o you wish to hear it again? (y/n) ";
680 [141]3900
682 [139]k$[178]"n"[167][153]k$:de[178].5:[141]7000:[141]8000:[137]80
684 [153]k$:de[178].5:[141]7000:[137]600
699 [143] real time play
700 [153]"load(NULL)(NULL)atn(NULL) atn (NULL)(NULL)(NULL)val !"
701 [153]"((NULL)ress the number keys on the keyboard  for the indicated solfege degree.)
710 forx=0to4:print"";:next
711 print"[164][164][164][164][164][164][164][164][164][164][164][164][164][164][164][164][164][164][164][164][164][164][164][164]
712 [153]"getstr$(NULL)sgn(NULL)valsgn(NULL)right$sgnascatnsgn(NULL)(NULL)sgn(NULL)atnsgn(NULL)right$sgnstr$(NULL)get
713 print"[161] 1[180] 2[180] 3[180] 4[180] 5[180] 6[180] 7[180] 8[161]
714 [153]"(NULL)ress <(NULL)(NULL)atnlenval peekatn(NULL)> to end this section."
760 [141]2000
770 [161]k$:[139]k$[178]""[167]770
780 k[178][198](k$)
790 [139]k[178]32[167][141]8000:[137]80
800 i[178]0
805 [139]k[178]as(i)[167][151]si,1:[151]si[170]1,1
810 [151]si[170]4,16:[139]k[178]as(i)[167][151]si,lm(i[170]8):[151]si[170]1,hm(i[170]8):[151]si[170]4,17:[137]770
820 i[178]i[170]1
830 [139]i[179][178]8[167]805
840 [137]770
899 [143] twinkle star melody
900 [153]"load(NULL)left$right$(NULL) right$(NULL) (NULL)(NULL)right$(NULL)(NULL)(NULL)val (NULL)(NULL)atn(NULL) (NULL)val(NULL)(NULL)str$(NULL) !"
905 [153]"((NULL)ress <(NULL)(NULL)atnlenval peekatn(NULL)> to end early.)"
910 [141] 2000
920 rl[178]1000:[141]11000
924 [129]i[178]1[164]172
925 [139]d[178][171]1[167]960
926 [151]si[170]4,16:[141]1200:[141]1220
927 [161]k$:[139]k$[178]" "[167]960
928 [130]
960 [141] 2000
970 [153]:[153]"str$o you wish to hear it again? (y/n) ";
980 [141]3900
982 [139]k$[178]"n"[167][153]k$:de[178].5:[141]7000:d[178]0:[141]8000:[137]80
984 [153]k$:de[178].5:[141]7000:d[178]0:[137]900
999 [143] twinkle star data
1000 [131] 1,8,8,1,1,8,8,1,1,12,8,3,1,12,8,3,1,13,8,4,1,13,8,4,2,12,8,3
1010 [131] 1,11,8,2,1,11,7,5,1,10,9,6,1,10,8,6,1,9,8,4,1,9,7,5,2,8,3,1
1020 [131] 1,12,8,3,1,12,8,3,1,11,8,2,1,11,7,2,1,10,8,1,1,10,8,3,2,9,7,5
1030 [131] 1,12,8,3,1,12,8,3,1,11,8,2,1,11,7,2,1,10,8,1,1,10,8,3,2,9,7,5
1040 [131] 1,8,8,1,1,8,8,1,1,12,8,3,1,12,8,3,1,13,8,4,1,13,8,4,2,12,8,3
1050 [131] 1,11,8,2,1,11,7,5,1,10,9,6,1,10,8,6,1,9,8,4,1,9,7,5,2,8,3,1
1060 [131] -1,0,0,0
1099 [143] twinkle star harmonized
1100 [153]"load(NULL)left$right$(NULL) right$(NULL) (NULL)(NULL)right$(NULL)(NULL)(NULL)val (NULL)(NULL)atn(NULL) left$atn(NULL)(NULL)(NULL)(NULL)right$(NULL)valstr$ !"
1105 [153]"((NULL)ress <(NULL)(NULL)atnlenval peekatn(NULL)> to end early.)"
1110 [141]2000
1120 rl[178]1000:[141]11000
1130 [129]i[178]1[164]172
1140 [139] d[178][171]1[167]1160
1150 [151]si[170]4,16:[151]si[170]11,16:[151]si[170]18,16:[141]1200:[141]1260
1152 [161]k$:[139]k$[178]" "[167]1160
1155 [130]
1160 d[178]0:[141]2000:[153]:[153]"str$o you wish to hear it again? (y/n) ";
1162 [141]3900
1164 [139]k$[178]"n"[167][153]k$:de[178].5:[141]7000:d[178]0:[141]8000:[137]80
1166 [153]k$:de[178].5:[141]7000:d[178]0:[137]1100
1199 [143] read twinkle star data
1200 [135] d,r1,r2,r3
1210 [142]
1219 [143] rem poke twinkle data for melody
1220 p1[178]lm(r1):p2[178]hm(r1)
1230 [151]si,p1:[151]si[170]1,p2
1235 [151]si[170]4,17
1240 de